home *** CD-ROM | disk | FTP | other *** search
/ Software 2000 / Software 2000 Volume 1 (Disc 1 of 2).iso / utilities / u558.dms / u558.adf / animstudio / Animation Studio / Animation Studio.amosSourceCode next >
AMOS Source Code  |  1989-08-17  |  31KB  |  575 lines
  1. '                       Andrew's Animation Studio V1.2 
  2. '                             by Andrew Forrest
  3. '                       ï¿½1991 Nice Aardvaark Software
  4. '14/4/91   
  5. Set Buffer 10
  6. On Error Proc OOPS
  7. Dim C(1,2),M$(4,1),Z(100,1)
  8. Global Z(),DIL$,XOFF,YOFF,ER,M$(),FILE$,TYPE,AA,MDE,FIL,PAT,INV,MAG,XZ,YZ,CX,CY,SX,SY,OX,OY,C(),FRMS,CELS,BNKS,CEL,HZ,F_ALT,A_ALT,GHO,MOU,SL,EROR$,FLAG,PLN,X_OF,Y_OF,R_
  9. INIT
  10. Do 
  11.    Repeat 
  12.       Multi Wait : MZ=Mouse Zone : MC=Mouse Click : M=X Screen(X Mouse)<128 : XY[M] : S=Scin(X Mouse,Y Mouse) : MOU
  13.       I$=Upper$(Inkey$) : SC=Scancode : SH=Key Shift : Clear Key : ALT=(SH and 48)<>False : SH=(SH and 3)<>False : If SC=33 : I$="S" : End If : If SC=50 : I$="X" : End If : If SC=52 Then I$="V"
  14.       If MC=2 and(MZ>88 and MZ<95 or MZ=84 or MZ=87) Then CLICK[MZ,""] : If Param Then Restore(MZ) : Read N : For M=0 To N-1 : Read M$(M,0),M$(M,1) : Next : MNU[N]
  15.       If MC=2 and MZ>96 Then CLICK[MZ,""] : If Param Then I$=Mid$(K$,MZ-83,1) : SH=True
  16.       If MC=1 and MZ>75 and MZ<84 Then I$=Str$(MZ-75)-" "
  17.       N=Instr("12345678",I$) : If N and SH=False Then BUTTN[PAT+75,"",True] : PAT=N : BUTTN[N+75,"",False]
  18.       If MC=1 and MZ>83 Then CLICK[MZ,""] : If Param Then I$=Mid$(K$,MZ-83,1) : SH=False
  19.       If MZ=75 and MC : SL=False
  20.          D=X Screen(X Mouse)-Z(75,0)/65536 : L=Max(100/CELS,6) : F=CEL : T=0
  21.          While Mouse Key<>False : Multi Wait 
  22.             N=Max(Min(X Screen(X Mouse)-D-146,100-L),0)
  23.             F=((N*(CELS-1)*2)/Max(100-L,1)+1)/2+1 : SZ[76,146+N,44,146+N+L,53]
  24.             If F<>CEL : S_FR[F] : End If 
  25.             If T<>N : T=N : Cls 2,146,44 To 247,54 : BUTTN[76,"",True] : End If 
  26.          Wend : SL=True : S_FR[False]
  27.       End If 
  28.       If CF<>Chip Free or FF<>Fast Free Then Screen 1 : Print At(0,0);Left$("Chip:"+Str$(Chip Free)+"      ",13) : Print Left$("Fast:"+Str$(Fast Free)+"      ",13) : CF=Chip Free : FF=Fast Free : Screen 0
  29.       N=I$="" and MDE=7 and S=1 and MC=False
  30.       If PX and Not N Then PST[PX,PY,%1100000] : PX=False : FZOOM
  31.       If N
  32.          If Amreg(0) and PX : Amreg(0)=False : PST[PX,PY,%1100000] : PX=False : End If 
  33.          If PX=False : PX=X : PY=Y : PST[PX,PY,%1100000] : FZOOM : End If 
  34.       End If 
  35.       If S=1 and MC : I=MC xor INV : Screen 1 : Ink I,1-I
  36.          R_UN : SX=X : SY=Y : Gr Locate X,Y : Set Paint False : Set Pattern PAT+27 and PAT<>8
  37.          If MDE>2 and MDE<6 or MDE=8 or MDE=9 : Gr Writing 2 : Plot X,Y : End If 
  38.          MNT=%11100000 and MC=1 or %100000 : OX=X : OY=Y
  39.          Repeat 
  40.             If MDE=2 : Draw To X,Y : End If 
  41.             If MDE=3 or MDE=8 or MDE=9 : Box SX,SY To X,Y : Box SX,SY To OX,OY : End If 
  42.             If MDE=5 : Draw SX,SY To X,Y : Draw SX,SY To OX,OY : End If 
  43.             If MDE=4 : ELIPSE[SX,SY,X,Y] : ELIPSE[SX,SY,OX,OY] : End If 
  44.             If MDE=6 : For N=1 To 10 : Plot X+Rnd(6)-Rnd(6),Y+Rnd(6)-Rnd(6) : Next : End If 
  45.             If MDE=7 : PST[X,Y,MNT] : End If 
  46.             If MDE=10 : Set Pattern False : Ink MC-1 : Bar X,Y To X+7,Y+7 : End If 
  47.             OX=X : OY=Y : FZOOM
  48.             If MDE<>2 and MDE<>6 and MDE<>7 : Repeat 
  49.                   Multi Wait : D=Amreg(0) : Amreg(0)=False
  50.             Until D or Mouse Key=False : End If : XY[M]
  51.          Until Mouse Key=False
  52.          If MDE=1 : Paint X,Y,1 : End If 
  53.          If MDE=3 or MDE=8 or MDE=9 : Box SX,SY To OX,OY : End If 
  54.          Gr Writing 1 : If FIL : Screen 2 : Cls 0,160,0 To 320,128 : Ink 1 : End If 
  55.          If MDE=3 : Box SX,SY To OX,OY : End If 
  56.          If MDE=4 : ELIPSE[SX,SY,OX,OY] : End If 
  57.          If MDE=5 : Draw SX,SY To OX,OY : End If 
  58.          X=Max(OX,SX) : Y=Max(OY,SY) : SX=Max(Min(OX,SX),160) : SY=Max(Min(OY,SY),0)
  59.          If FIL
  60.             Set Pattern False : Paint(X+SX)/2,(Y+SY)/2
  61.             Screen Copy 2,160,0,320,128 To 1,160,0,%100000
  62.             Ink I,1-I : Set Pattern PAT+27 and PAT<>8 : Paint(X+SX)/2,(Y+SY)/2
  63.             Screen Copy 2,160,0,320,128 To 1,160,0,%11100000
  64.          G_FR[CEL-1] : End If 
  65.          If MDE=8 or MDE=9 : Screen 3 : Cls 0,0,0 To 160,128 : Screen 1 : Screen Copy 1,SX,SY,X+1,Y+1 To 3,0,0 : CX=X-SX+1 : CY=Y-SY+1 : End If 
  66.          If MDE=9 : Cls 1-I,SX,SY To X+1,Y+1 : End If 
  67.          If MDE<>8 : F_ALT=True : End If : If MDE=8 or MDE=9 : MDE=7 : MDE : End If 
  68.          If AA : I$=Chr$(28) : End If 
  69.       FZOOM : Screen False : End If 
  70.       If SC=95 Then REQUEST['Read file "Animation.DOC"','from workbench for instructions',"Ok","",""]
  71.    Until Instr(K$+"2468 ()*+,-./EGIJLMNQRUWZ{~",I$)
  72.    If I$=Chr$(28) Then S_FR[Min(CEL+1,CELS)]
  73.    If I$=Chr$(29) Then S_FR[Max(CEL-1,1)]
  74.    If I$=Chr$(30) Then S_FR[1]
  75.    If I$=Chr$(31) Then S_FR[CELS]
  76.    If I$=" " and S=1 Then XY[X Screen(X Mouse)<160] : XZ=Min(Max((X-64/MAG)/16*16,160),320-128/MAG) : YZ=Min(Max(Y-(56/MAG),False),128-112/MAG) : Gosub BX : FZOOM : Multi Wait : Gosub BX
  77.    If I$="(" and CEL<CELS Then S_FR[CEL+1] : R_UN : Screen Copy 2,160,0,320,128 To 1,160,0,%11100000 : F_ALT=True : FZOOM
  78.    If I$=")" and CEL>1 Then S_FR[False] : Screen Copy 2,160,0,320,128 To 1,160,0 : Dec CEL : F_ALT=True : S_FR[CEL]
  79.    If I$="{" and CEL<>CELS : S_REQ["Copy forwards how many?",CELS-CEL,1] : If Param : Screen Copy 1,160,0,320,128 To 3,160,0 : R_=False : For C=CEL+1 To CEL+Param : S_FR[C] : Screen Copy 3,160,0,320,128 To 1,160,0,%11100000 : F_ALT=True : Next 
  80.    FZOOM : R_=True : R_UN : A_ALT=True : End If : End If 
  81.    If I$="?" Then INFO
  82.    If Instr("IP,.",I$) Then PL
  83.    If Instr("AGJRMNQUWZ",I$) Then Gosub I$
  84.    If Instr("ELS",I$) and SH=False and ALT=False Then Gosub I$
  85.    If I$="+" and SH=False and CELS<9999 Then Inc CELS : NIX[CELS] : S_FR[False]
  86.    If I$="-" and SH=False and CELS>1 Then Dec CELS : S_FR[Min(CEL,CELS)] : Del Icon CELS+1
  87.    M=Instr("FDBO\YVCX",I$) : If M and SH=False and ALT=False Then MDE=M : FIL=False : MDE
  88.    If I$="*" and SH=True and CELS>1 Then Del Icon CEL : F_ALT=False : Dec CELS : S_FR[Min(CEL,CELS)]
  89.    If I$="/" and SH=True and CELS<9999 Then S_FR[False] : Ins Icon CEL : NIX[CEL] : Inc CELS : S_FR[CEL]
  90.    If Instr("2468BCDEFLOSVX",I$) and SH Then Gosub "S"+I$ : FZOOM
  91.    If I$="+" and SH and CELS<9999 Then S_FR[False] : Ins Icon 1 : NIX[1] : Inc CELS : S_FR[CEL+1]
  92.    If I$="-" and SH and CELS>1 Then S_FR[False] : Del Icon 1 : Dec CELS : S_FR[Max(CEL-1,1)]
  93.    If Instr("SVX",I$) and ALT Then Gosub "�"+I$ : I$=""
  94.    If I$="*" and ALT and CELS-CEL+1>1 Then S_REQ["Delete how many?",Min(CELS-CEL+1,CELS-1),1] : If Param Then Del Icon CEL To CEL+Param-1 : Add CELS,-Param : F_ALT=False : S_FR[Min(CEL,CELS)]
  95.    If I$="/" and ALT and CELS<9999 Then S_REQ["Insert how many?",9999-CELS,1] : If Param Then Change Mouse 18 : MOU=18 : S_FR[False] : For N=1 To Param : Ins Icon CEL : NIX[CEL] : Next : Add CELS,Param : S_FR[CEL] : MOU
  96. Loop 
  97. 84 Data 2,"Add last frame","+","Remove last frame","-"
  98. 87 Data 2,"Add first frame","^+","Remove first frame","^-"
  99. 89 Data 5,"Play forwards",".","Play backwards",",","Play indefinitely","I","`Bounce'","^I","Set rate...","R"
  100. 90 Data 5,"Undo","U","New animation","N","Change zoom","M","Clear all frames","E","Quit","Q"
  101. 91 Data 5,"Load animation...","L","Append animation...","J","Load frame...","^L","Save as...","�S","Save frame...","^S"
  102. 92 Data 5,"Cut frame","^X","Cut & remove","�X","Remove frame","^*","Remove block...","�*","Clear frame","^E"
  103. 93 Data 4,"Copy frame to next","(","Copy frame to previous",")","Copy forwards","{","Copy frame","^C"
  104. 94 Data 4,"Paste frame","^V","Insert & paste","�V","Insert frame","^/","Insert block...","�/"
  105. A: AA= Not AA : CHECK[88,AA] : Return 
  106. E: CONFIRM["Clear"] : If Param Then For F=1 To CELS : NIX[F] : Next : F_ALT=False : S_FR[CEL] : Return Else Return 
  107. G: GHO= Not GHO : GHO : Return 
  108. J: LD[False] : Return 
  109. L: LD[True] : Return 
  110. M: MAG=6-MAG : FZOOM : Return 
  111. N: ERA["Delet"] : Return 
  112. Q: ERA["Quit"] : If Param Then Erase 2 : Edit Else Return 
  113. R: S_REQ["Set Rate",60,HZ] : If Param Then HZ=Param : Return Else Return 
  114. S: SVE[False] : Return 
  115. W: INV=3-INV : Return 
  116. U:
  117. Z: Screen Copy 1,160,0,320,128 To 2,160,0 : Screen Copy 3,160,0,320,128 To 1,160,0 : Screen Copy 2,160,0,320,128 To 3,160,0 : Screen 2 : G_FR[CEL-1] : Screen False : FZOOM : Return 
  118. S2: YZ=Min(YZ+1,128-112/MAG) : Return 
  119. S4: XZ=Max(XZ-8,160) : Return 
  120. S6: XZ=Min(XZ+8,320-128/MAG) : Return 
  121. S8: YZ=Max(YZ-1,0) : Return 
  122. SB: MDE=3 : FIL=True : MDE : Return 
  123. SC: Screen Copy 1,160,0,320,128 To 3,0,0 : CX=160 : CY=128 : Return 
  124. SD: MDE=10 : FIL=False : MDE : Return 
  125. SE: R_UN : Screen 1 : Cls 0,160,0 To 320,128 : Screen False : F_ALT=True : FZOOM : Return 
  126. SF: PAL : Return 
  127. SL: Repeat : FSEL["","Load an ILBM picture"] : F$=Param$ : If F$="" Then Return 
  128. Until Exist(F$) : ER=False : MOU=18 : Change Mouse 18 : Open In 1,F$ : CHUNK["G_ILBM","","ROOT",Lof(1)] : If ER Then REQUEST[EROR$,"Abandoning Load","Ok","",""]
  129. Close : F_ALT=True : MOU : Screen False : Return 
  130. SO: MDE=4 : FIL=True : MDE : Return 
  131. SS: Screen 1 : SVE_F : Screen False : Return 
  132. SV: R_UN : Screen Copy 3,0,0,CX,CY To 1,160,0 : F_ALT=True : FZOOM : Return 
  133. SX: Gosub SC : Gosub SE : Return 
  134. �S: SVE[True] : Return 
  135. �V: If CELS<9999 Then S_FR[False] : Ins Icon CEL : Inc CELS : NIX[CEL] : S_FR[CEL] : Gosub SV : Return Else Return 
  136. �X: If CELS>1 Then Gosub SC : Del Icon CEL : F_ALT=False : Dec CELS : S_FR[Min(CEL,CELS)] : Return Else Return 
  137. BX: Screen 1 : Gr Writing 2 : Box XZ-1,YZ-1 To XZ+128/MAG,YZ+112/MAG : Gr Writing False : Screen False : Return 
  138. Procedure INIT
  139.    Shared K$
  140.    On Error Proc OOPS
  141.    Close Workbench : Close Editor : No Mask : For N=3 To 7 : Make Mask N : Next N
  142.    DIL$=Chr$(0)+Chr$(0)+Chr$(160)+Chr$(57) : FILE$="" : K$=Chr$(31)+Chr$(28)+Chr$(29)+Chr$(30)+"AP?SXCVY\OBDF"
  143.    MDE=2 : MAG=2 : XZ=160 : CEL=1 : CELS=1 : HZ=24 : PAT=8 : A_ALT=False : SL=True : C(0,0)=15 : C(0,1)=15 : C(0,2)=15 : GHO=True : R_=True
  144.    Screen Open 1,320,128,2,Lowres : Screen Display 1,128,108,, : Get Sprite Palette : Curs Off : Cls 0 : Set Pattern 2 : Set Paint True : Ink 0,1,1 : Bar 128,-1 To 159,128 : Clip 160,0 To 320,128 : NIX[1]
  145.    Screen Open 2,320,128,2,Lowres : Screen Display 2,128,108,, : Clip 160,0 To 320,128 : Cls False
  146.    Screen Open 3,320,128,2,Lowres : Screen Display 3,208,108,160, : Screen Offset 3,160,0 : Get Sprite Palette : Screen Hide 3 : Cls 0 : Wait Vbl : Dual Playfield 1,2 : Unpack 15 To 0 : Reserve Zone 100 : Limit Mouse 128,50 To 447,235
  147.    Get Rom Fonts : N=1 : F=False : T$="TIMES.FONT                    11  " : While Font$(N)<>"" : If Left$(Upper$(Font$(N)),34)=T$ : Set Font N : F=True : End If : Inc N : Wend 
  148.    If Not F : Get Disc Fonts : N=1 : While Font$(N)<>"" : If Left$(Upper$(Font$(N)),34)=T$ : Set Font N : F=True : End If : Inc N : Wend : If Not F : Set Font 0 : End If : End If 
  149.    For Z=0 To 6 : SZ[100-Z,Z*20+5,32,Z*20+24,51] : Next : SZ[92,105,12,124,31] : SZ[93,125,12,144,31]
  150.    For Z=0 To 2 : SZ[91-Z,Z*20+257,6,Z*20+276,25] : Next 
  151.    For Z=0 To 4 : SZ[88-Z,Z*12+257,28,Z*12+268,39] : Next 
  152.    Z=76 : For Y=4 To 23 Step 19 : For X=147 To 204 Step 19 : SZ[Z,X,Y,X+18,Y+18] : Inc Z : Next : Next 
  153.    Amal 0,"L: P;I X<>XM J A; I Y<>YM J A;J L;A: L X=XM; L Y=YM; L RA=-1; J L" : Amal On 
  154.    REFRESH : Clear Key 
  155. End Proc
  156. Procedure INFO
  157.    DILOG_O[50,3,210,50]
  158.    Ink 0 : CENT[130,11,"by Andrew Forrest"] : CENT[130,25,"�1991 Nice Aardvaark Software"] : Ink 1 : WRITE[66,40,"V1.2"]
  159.    BUT_O[70,105,30,"Ok"] : Ink 1 : Draw 70+XOFF,14+YOFF To 190+XOFF,14+YOFF
  160.    Sprite 8,X Hard(9+XOFF),Y Hard(11+YOFF),16 : Channel 1 To Sprite 8 : Amal 1,"L: L A=16; L Y=Y+3; F R0=1 T 200; N R0; L A=17; L Y=Y-3; F R0=1 T 200; N R0; J L;" : Amal On 
  161.    Repeat : Repeat : Until Mouse Click and Mouse Zone=70 : CLICK[70,"Ok"] : Until Param
  162.    Sprite Off 8 : DILOG_C[70]
  163. End Proc
  164. Procedure SVE[NEW]
  165.    On Error Proc OOPS
  166.    P=False
  167.    If FILE$="" or NEW
  168.       FSEL[".PAF","Save as what name?"]
  169.       If Param$="" : Goto FIN : End If 
  170.       If Exist(Param$) : REQUEST["File exists.","Overwrite?","Yes","Cancel",""] : If Param=2 : Goto FIN : End If : End If 
  171.    FILE$=Param$ : End If 
  172.    Change Mouse 18 : MOU=18 : S_FR[False]
  173.    ER=False : Open Out 1,FILE$
  174.    OUT["PAF2"+Chr$(CELS/256)+Chr$(CELS mod 256)]
  175.    OUT[Chr$(C(0,0))+Chr$(C(0,1))+Chr$(C(0,2))+Chr$(C(1,0))+Chr$(C(1,1))+Chr$(C(1,2))]
  176.    OUT[Chr$((AA and 4)+(GHO and 2)+(INV=3 and 4))+Chr$(HZ)] : If Param : Goto OOPS : End If 
  177.    For F=1 To CELS : Screen False : SLD[76,145,43,247,F,CELS] : Screen 1 : G_FR[F] : I=Icon Base(F) : SX=Deek(I+6)
  178.       If SX : SY=Deek(I+8) : OX=SX+Deek(I)*16 : OY=SY+Deek(I+2)
  179.          Pack 1 To 14,SX,SY,OX,OY : OUT[Chr$(Length(14)/256)+Chr$(Length(14) mod 256)]
  180.          For A=Start(14) To Start(14)+Length(14)-1
  181.             OUT[Chr$(Peek(A))]
  182.          Next : Erase 14
  183.       Else 
  184.          OUT[Chr$(0)+Chr$(0)]
  185.       End If : If Param : Goto OOPS : End If 
  186.    Next 
  187.    Close 1 : A_ALT=False : P=True : Goto FIN
  188.    OOPS: Close : Kill FILE$ : REQUEST["ERROR!","Abandoning save","Ok","",""] : P=False
  189.    FIN: S_FR[CEL]
  190. End Proc[P]
  191. Procedure SVE_F
  192.    On Error Proc OOPS
  193.    FSEL[".ILBM","Save a single frame"] : If Param$="" Then Pop Proc Else F$=Param$
  194.    If Exist(F$) Then REQUEST["File exists.","Overwrite?","Yes","No",""] : If Param=2 Then Pop Proc
  195.    F=Free : MOU=18 : Change Mouse 18 : Open Out 1,F$ : I=Icon Base(CEL) : SX=Deek(I)*2 : SY=Deek(I+2) : OX=Deek(I+6)-160 : OY=Deek(I+8) : OUT["FORM"] : OUTL[54+SX*SY]
  196.    OUT["ILBMBMHD"] : OUTL[20] : OUTW[SX*8] : OUTW[SY] : OUTW[OX] : OUTW[OY] : OX=OX/8
  197.    OUT[Chr$(1)+Chr$(0)+Chr$(0)+Chr$(0)] : OUTW[False] : OUT[Chr$(10)+Chr$(11)] : OUTW[160] : OUTW[128]
  198.    OUT["CMAP"] : OUTL[6] : OUT[Chr$(C(0,0)*16)+Chr$(C(0,1)*16)+Chr$(C(0,2)*16)+Chr$(C(1,0)*16)+Chr$(C(1,1)*16)+Chr$(C(1,2)*16)]
  199.    OUT["BODY"] : OUTL[SX*SY] : For Y=OY*40 To(OY+SY-1)*40 Step 40 : For X=OX+20 To OX+SX+19 : F=Free : OUT[Chr$(Peek(Logbase(False)+X+Y))] : Next : Next 
  200.    Close : MOU : Pop Proc
  201.    OOPS3: Close : Kill FILE$ : REQUEST["ERROR!","Abandoning save","Ok","",""]
  202. End Proc
  203. Procedure LD[NEW]
  204.    On Error Proc OOPS
  205.    If NEW Then ERA["Load"] : If Not Param Then Pop Proc
  206.    Repeat : FSEL["","Load an animation"] : If Param$="" Then Goto FIN2
  207.    Until Exist(Param$) : FILE$=Param$ : If NEW Then Erase 2 : CELS=False
  208.    ER=False : Open In 1,FILE$ : CEL=CELS+1
  209.    IN[4] : T$=Param$ : Change Mouse 18 : MOU=18
  210.    If T$="PAF1" or(T$="PAF2") : IN[8+(T$="PAF2" and 2)] : If ER : Goto OOPS2 : End If : A$=Param$ : A=Varptr(A$) : Add CELS,Deek(A)
  211.       If T$="PAF1" : C(0,0)=Peek(A+2) : C(0,1)=Peek(A+3)/16 : C(0,2)=Peek(A+3) mod 16 : C(1,0)=Peek(A+4) : C(1,1)=Peek(A+5)/16 : C(1,2)=Peek(A+5) mod 16 : Add A,6
  212.       Else 
  213.       Add A,2 : For C=0 To 1 : For N=0 To 2 : C(C,N)=Peek(A) : Inc A : Next : Next : End If 
  214.       AA=(Peek(A) and 4)<>False : GHO=(Peek(A) and 2)<>False : CL : INV=(Peek(A) and 1)<>False and 3 : HZ=Peek(A+1)
  215.       For C=CEL To CELS : IN[2] : A$=Param$ : A=Deek(Varptr(A$)) : If ER : Goto OOPS2 : End If 
  216.          Screen False : SLD[76,145,43,247,C,CELS] : Screen 1 : Cls 0,160,0 To 320,128
  217.          If A : Reserve As Work 14,A
  218.             For P=Start(14) To Start(14)+A-1
  219.                IN[1] : Poke P,Asc(Param$)
  220.             Next : If ER : Goto OOPS2 : End If : Unpack 14 : S=Start(14)
  221.             X=Deek(S+4)*8 : Y=Deek(S+6) : Erase 14
  222.             Get Icon C,X,Y To X+Deek(S+8)*8,Y+Deek(S+10)*Deek(S+12) : Doke Icon Base(C)+6,X : Doke Icon Base(C)+8,Y
  223.          End If 
  224.       Next 
  225.    Else 
  226.       CELS=1 : NIX[1] : REQUEST["Unrecognised","file format.","Ok","",""]
  227.    End If 
  228.    FIN2: If CELS=False : NIX[1] : CELS=1 : End If : Screen False : Close : S_FR[1] : MOU : A_ALT=False : CHECK[88,AA] : Pop Proc
  229.    OOPS2: CELS=Max(CELS,1) : REQUEST["ERROR!","Abandoning load","Ok","",""] : CELS=C : NIX[CEL] : Goto FIN2
  230. End Proc
  231. Procedure CHUNK[CLNT$,PROP$,FTHR$,LIM]
  232.    On Error Proc OOPS
  233.    FLAG=False
  234.    Repeat : If Pof(1)>LIM Then EROR$="Corrupt IFF structure" : ER=True : Pop Proc
  235.       F=Free : CLAS$=Input$(1,4) : LGTH$=Input$(1,4) : LGTH=Leek(Varptr(LGTH$))
  236.       POS=Pof(1)+LGTH+(LGTH mod 2) : If POS>LIM Then EROR$="Corrupt IFF file" : ER=True : Pop Proc
  237.       TYPE$="" : If CLAS$="LIST" or(CLAS$="CAT ") or(CLAS$="PROP") or(CLAS$="FORM") Then TYPE$=Input$(1,4)
  238.       If TYPE$="" and(FTHR$<>"FORM") and(FTHR$<>"PROP") Then EROR$="Illegal IFF construction" : ER=True : Pop Proc
  239.       Gosub CLNT$ : If ER Then Pop Proc
  240.       If CLAS$="CAT " and FLAG and 4 Then CHUNK[CLNT$,"","CAT ",POS]
  241.       If CLAS$="LIST" and FLAG and 2 Then CHUNK[CLNT$,"","LIST",POS]
  242.       If CLAS$="PROP" Then If FTHR$="LIST" Then Pof(1)=Pof(1)-12 : PROP$=PROP$+Input$(1,LGTH+8+(LGTH mod 2)) Else EROR$="Illegal IFF construct" : ER=True : Pop Proc
  243.       Pof(1)=POS
  244.    Until Pof(1)=LIM or FLAG and 1
  245.    Pop Proc
  246.    
  247.    G_ILBM:
  248.    If CLAS$="FORM"
  249.       If TYPE$="ILBM"
  250.          If FTHR$="LIST"
  251.             CHUNK["F_ILBM",PROP$,"FORM",POS]
  252.          Else 
  253.             CHUNK["F_ILBM","","FORM",POS]
  254.          End If : FLAG=%1
  255.       Else 
  256.          CHUNK[CLNT$,"","FORM",POS]
  257.       End If 
  258.    End If 
  259.    FLAG=FLAG or %110 : Return 
  260.    
  261.    F_ILBM:
  262.    If CLAS$="BMHD" or(CLAS$="CAMG") or(CLAS$="CMAP") Then Pof(1)=Pof(1)-8 : F=Free : PROP$=PROP$+Input$(1,LGTH+8+(LGTH mod 2))
  263.    If CLAS$="BODY" : F=Free : PTR=Varptr(PROP$) : P=0 : Screen 1
  264.       While P<Len(PROP$) : P$=Mid$(PROP$,P+1,4) : NX=P+Leek(PTR+4)+8+(Leek(PTR+4) mod 2) : Add PTR,8
  265.          If P$="CAMG" : REZ=Leek(PTR) and $8004 : End If 
  266.          If P$="BMHD" : WDTH=(Deek(PTR)+15)/16*2 : HGHT=Deek(PTR+2) : OX=Deek(PTR+4)/8 : OY=Deek(PTR+6) : PLNS=Peek(PTR+8)+(Peek(PTR+9)=1) : COMP=Peek(PTR+10) : End If 
  267.          If P$="CMAP" : C(0,0)=Peek(PTR)/16 : C(0,1)=Peek(PTR+1)/16 : C(0,2)=Peek(PTR+2)/16 : C(1,0)=Peek(PTR+3)/16 : C(1,1)=Peek(PTR+4)/16 : C(1,2)=Peek(PTR+5)/16 : End If 
  268.       P=NX : PTR=Varptr(PROP$)+P : Wend 
  269.       For Y=0 To Min(HGHT-1,127+Y_OF)
  270.          For P=1 To PLNS : F=Free
  271.             If PLN+1=P
  272.                If COMP=0 : For X=0 To WDTH-1 : PLOP[X,Y,Asc(Input$(1,1))] : Next : End If 
  273.                If COMP=1 : X=False
  274.                   Repeat : I$=Input$(1,1) : N=Asc(I$) : F=Free : If Pof(1)>POS : EROR$="Corrupt BODY data" : End If 
  275.                      If N<128 : For C=1 To N+1 : PLOP[X,Y,Asc(Input$(1,1))] : Inc X : Next : End If 
  276.                      If N>128 : I$=Input$(1,1) : CL=Asc(I$) : For C=1 To 257-N : PLOP[X,Y,CL] : Inc X : Next : End If 
  277.                   Until X>WDTH-1
  278.                End If 
  279.             Else 
  280.                If COMP=0 : Pof(1)=Pof(1)+WDTH : End If 
  281.                If COMP=1 : OF=False
  282.                   Repeat : I$=Input$(1,1) : N=Asc(I$) : F=Free
  283.                      If N<128 : Pof(1)=Pof(1)+N+1 : Add OF,N+1 : End If 
  284.                      If N>128 : Pof(1)=Pof(1)+1 : Add OF,257-N : End If 
  285.                   Until OF>WDTH-1
  286.                End If 
  287.             End If 
  288.          Next 
  289.       Next 
  290.    End If 
  291.    Return 
  292. End Proc
  293. Procedure PLOP[X,Y,B]
  294.    If X+OX>=X_OF and X+OX<20+X_OF and Y+OY>=Y_OF and Y+OY<128+X_OF Then Poke Logbase(0)+20+X+OX-X_OF+40*(Y+OY-Y_OF),B
  295. End Proc
  296. Procedure PAL
  297.    DILOG_O[112,2,112,53] : Z=70 : Set Paint True : Set Pattern False : Gr Writing False
  298.    For C=0 To 1 : For N=0 To 2 : X=71*C+12*N+2+XOFF : CO=C(C,N) : Ink False,2,0
  299.          Box X,2+YOFF To 12+X,39+YOFF : Ink 4 : Bar X,39+YOFF To 12+X,50+YOFF : Ink 0 : Text X+3,48+YOFF,Right$(Hex$(CO),1)
  300.          SZ[Z,X+1-XOFF,33-CO*2,X+11-XOFF,38-CO*2] : BUTTN[Z,"",True] : Dec Z
  301.    Next : Next : SZ[64,39,38,72,49] : BUTTN[Z,"Ok",True]
  302.    SZ[63,42,5,53,16] : CHECK[63,INV<>False] : Paste Bob 41+XOFF,18+YOFF,12
  303.    SZ[62,56,5,67,16] : CHECK[62,GHO] : Paste Bob 55+XOFF,18+YOFF,13
  304.    Z=False : Repeat : Repeat : Multi Wait : MC=Mouse Click : Until MC : MZ=Mouse Zone
  305.       If MZ=62 Then CLICK[62,""] : If Param Then GHO= Not GHO : CHECK[62,GHO] : GHO
  306.       If MZ=63 Then CLICK[63,""] : If Param Then INV=3-INV : CHECK[63,INV<>False]
  307.       If MZ=64 Then CLICK[64,"Ok"] : Z=Param
  308.       If MZ>64 and MZ<71 : D=Y Screen(Y Mouse)-(Z(MZ,0) mod 65536)
  309.          X=Z(MZ,0)/65536 : CO=(70-MZ)/3 : N=(70-MZ) mod 3
  310.          Repeat : Multi Wait : MC=Mouse Key
  311.             Y=Min(Max(Y Screen(Y Mouse)-D-YOFF,3),33)
  312.             If Y<>T : SZ[MZ,X-XOFF,Y,X+10-XOFF,Y+5] : Cls 2,X,3+YOFF To X+11,39+YOFF : BUTTN[MZ,"",True] : T=Y : End If 
  313.             C=(33-Y)/2 : C(CO,N)=C : CL : Ink 4,,0 : Bar X-1,39+YOFF To 11+X,50+YOFF : Ink 0 : Text X+2,48+YOFF,Right$(Hex$(C),1)
  314.          Until MC=False
  315.       End If 
  316.    Until Z
  317.    DILOG_C[70]
  318. End Proc
  319. Procedure PL
  320.    Shared I$,SH
  321.    S_FR[False] : Screen Show 3 : Screen Hide 0 : D=3 : Clear Key : T=(CELS*50)/HZ : B=I$=","
  322.    Screen 1 : Cls 0,160,0 To 320,128 : Colour 9,Colour(0) : Screen Display 1,208,,160, : Screen Offset 1,160,
  323.    Wait Vbl : If Instr("PI",I$) Then Timer=0 Else Timer=(CEL*50)/HZ
  324.    Repeat 
  325.       Screen To Front D : If Timer>=T Then Timer=0 : If I$="I" and SH Then B= Not B
  326.       F=(Timer*HZ)/50+1 : If B Then F=CELS-F+1
  327.       D=4-D : Screen D : G_FR[F] : Wait Vbl 
  328.    Until I$="P" and Timer>=T or(Inkey$<>"") or Mouse Key
  329.    Screen Display 1,128,,320, : Screen Offset 1,0, : GHO
  330.    Screen Hide 3 : Screen Show 0 : Screen Show 1 : Screen 1 : G_FR[CEL] : FZOOM : R_UN : Screen False
  331. End Proc
  332.  
  333. Procedure OOPS
  334.    S=Screen : Screen 0 : DILOG_O[140,6,140,44]
  335.    Ink 0 : WRITE[8,11,"Error Number"+Str$(Errn)]
  336.    T$="Disk Error" : If Errn<79 Then T$="Graphics Error"
  337.    If Errn<64 Then T$="Window Error"
  338.    If Errn<45 Then T$="Miscellaneous Error"
  339.    If Errn=24 Then T$="Out of Memory"
  340.    T=Text Length(T$) : WRITE[70-T/2,21,T$]
  341.    Paste Bob 8+XOFF,23+YOFF,1
  342.    BUT_O[1,48,25,"Ok"]
  343.    Repeat : Repeat : MZ=Mouse Zone : I$=Inkey$ : SC=Scancode : If SC=69 Then Edit 
  344.       Until Mouse Key and MZ=1 : CLICK[1,"Ok"]
  345.    Until Param : DILOG_C[2] : Screen S : ER=True
  346.    Resume Next 
  347. End Proc
  348. Procedure FZOOM
  349.    W=128/MAG : H=112/MAG : Dreg(1)=MAG : Dreg(4)=0 : Dreg(5)=16 : Dreg(6)=W : Dreg(7)=H
  350.    Dreg(2)=Min(XZ,320-W) : Dreg(3)=Min(YZ,128-H)
  351.    S=Screen : Screen 1 : Call 13 : Screen 2 : Call 13 : Screen S
  352. End Proc
  353. Procedure XY[M]
  354.    Shared X,Y
  355.    X=X Screen(1,X Mouse) : Y=Y Screen(1,Y Mouse) : If M Then X=X/MAG+XZ : Y=(Y-16)/MAG+YZ
  356. End Proc
  357. Procedure R_UN
  358.    If R_ Then Screen Copy 1,160,0,320,128 To 3,160,0
  359. End Proc
  360. Procedure ELIPSE[X,Y,X2,Y2]
  361.    DX=X2-X : DY=Y2-Y
  362.    If DX<0 Then X2=X-DX : DX=-DX
  363.    If DY<0 Then Y2=Y-DY : DY=-DY
  364.    If DX=0 Then Draw X,Y-DY To X,Y+DY
  365.    If DY=0 Then Draw X-DX,Y To X+DX,Y
  366.    If DX>0 and DY>0 Then Ellipse X,Y,DX,DY
  367. End Proc
  368. Procedure MOU
  369.    Shared S
  370.    If S=False Then M=1 Else If S=1 Then M=2+(MDE=10 and 15) Else Pop Proc
  371.    If MOU<>M Then Change Mouse M : MOU=M
  372. End Proc
  373. Procedure REFRESH
  374.    Unpack 15 : CHECK[88,AA] : MDE : BUTTN[PAT+75,"",False] : S_FR[False]
  375. End Proc
  376. Procedure MDE
  377.    If MDE<8 Then Screen Copy 0,MDE*20-13,34,MDE*20+3,50 To 0,228,8
  378.    If MDE=8 Then Screen Copy 0,127,14,143,30 To 0,228,8
  379.    If MDE=9 Then Screen Copy 0,107,14,123,30 To 0,228,8
  380.    If MDE=10 Then Cls 2,228,8 To 244,24 : Ink 4,,0 : Set Paint True : Bar 232,12 To 239,19
  381.    If FIL Then Ink 5,7, : Set Pattern 31 : Gr Writing 1 : Paint 235,16 : Set Pattern False
  382. End Proc
  383. Procedure CL
  384.    Screen 1 : Colour 0,C(0,0)*256+C(0,1)*16+C(0,2) : Colour 1,C(1,0)*256+C(1,1)*16+C(1,2) : GHO : Screen 3 : Get Palette 1 : Screen False
  385. End Proc
  386. Procedure GHO
  387.    S=Screen : Screen 1 : If GHO Then Colour 9,(C(0,0)+C(1,0))/2*256+(C(0,1)+C(1,1))/2*16+(C(0,2)+C(1,2))/2 Else Colour 9,Colour(0)
  388.    Screen S
  389. End Proc
  390. Procedure PST[X,Y,M]
  391.    If X+CX/2<160 Then Pop Proc
  392.    Screen Copy 3,Max(160-(X-CX/2),0),0,CX,CY To 1,Max(X-CX/2,160),Y-CY/2,M
  393. End Proc
  394. Procedure OUT[T$]
  395.    On Error Proc OOPS
  396.    If ER Then Pop Proc
  397.    F=Free : Print #1,T$;
  398. End Proc[ER]
  399. Procedure OUTW[N]
  400.    On Error Proc OOPS
  401.    OUT[Chr$(N/256)+Chr$(N and $FF)]
  402. End Proc[Param]
  403. Procedure OUTL[N]
  404.    On Error Proc OOPS
  405.    OUTW[N/65536] : OUTW[N and $FFFF]
  406. End Proc[Param]
  407. Procedure IN[N]
  408.    On Error Proc OOPS
  409.    If Not ER Then T$=Input$(1,N) Else T$=""
  410. End Proc[T$]
  411. Procedure FSEL[D$,T$]
  412.    F=Free : MOU=1 : Change Mouse 1 : F$=Fsel$("",D$,T$) : MOU
  413. End Proc[F$]
  414.  
  415. Procedure BANK
  416.    Repeat : N=BNKS-3-FRMS/1000
  417.       If N<False Then Inc BNKS : Reserve As Work BNKS,2000
  418.       If N>5 Then Erase BNKS : Dec BNKS
  419.    Until N=False
  420. End Proc
  421. Procedure ERA[A$]
  422.    P=True : CONFIRM[A$] : If Not Param Then P=False : Goto FIN3
  423.    R_UN : NIX[1] : F_ALT=False : If CELS>1 Then Del Icon 2 To CELS : CELS=1 : CEL=1
  424.    S_FR[1] : A_ALT=False : FILE$=""
  425.    FIN3:
  426. End Proc[P]
  427. Procedure G_FR[F]
  428.    Cls 0,160,0 To 320,128 : If F>0 and F<=CELS Then If Deek(Icon Base(F)+6)<>False Then Paste Icon Deek(Icon Base(F)+6),Deek(Icon Base(F)+8),F
  429. End Proc
  430. Procedure S_FR[F]
  431.    Screen 1
  432.    If F_ALT : A_ALT=True : F_ALT=False : Change Mouse 18 : MOU=18
  433.       L=Logbase(0) : SY=False : OY=128
  434.       For M=False To 5080 Step 40
  435.          For N=20 To 36 Step 4
  436.             Exit If Leek(L+M+N)<>False,2
  437.          Next 
  438.       Inc SY : Next 
  439.       If SY<>128
  440.          For M2=5080 To M Step -40
  441.             For N=20 To 36 Step 4
  442.                Exit If Leek(L+M2+N)<>False,2
  443.             Next 
  444.          Dec OY : Next 
  445.          For M3=20 To 39
  446.             For N=M To M2 Step 40
  447.                Exit If Peek(L+M3+N)<>False,2
  448.             Next 
  449.          Next : SX=M3*8
  450.          For M4=39 To M3 Step -1
  451.             For N=M To M2 Step 40
  452.                Exit If Peek(L+M4+N)<>False,2
  453.             Next 
  454.          Next : OX=M4*8+8
  455.          Get Icon CEL,SX,SY To OX,OY : Doke Icon Base(CEL)+6,SX : Doke Icon Base(CEL)+8,SY
  456.       Else 
  457.          NIX[CEL]
  458.       End If : MOU
  459.    End If 
  460.    If F Then CEL=F : G_FR[F] : Screen 2 : G_FR[F-1] : FZOOM : R_UN
  461.    Screen False : If SL Then L=Max(100/CELS,6) : N=((100-L)*(CEL-1))/Max(1,CELS-1) : SZ[75,146+N,44,146+N+L,53] : Cls 2,146,44 To 247,54 : BUTTN[75,"",True]
  462.    Cls 4,250,44 To 280,54 : Cls 4,286,44 To 316,54 : Ink 0 : Gr Writing False : Text 250,52,Left$(Str$(CEL),4) : Text 286,52,Left$(Str$(CELS),4)
  463. End Proc
  464. Procedure NIX[F]
  465.    S=Screen : Screen 1 : Get Icon F,0,0 To 16,1 : Doke Icon Base(F)+6,False : Doke Icon Base(F)+8,False : Screen S
  466. End Proc
  467.  
  468. Procedure MNU[I]
  469.    Shared I$,SH,ALT
  470.    DILOG_O[120,25-I*5,158,7+I*10] : S=False
  471.    For N=0 To I-1
  472.       SZ[70-N,3,N*10+3,155,N*10+12] : Gosub D_ITEM
  473.    Next 
  474.    Repeat 
  475.       Repeat : Multi Wait : I$=Inkey$ : KS=Key Shift and 3 : MC=Mouse Click : Until I$<>"" or MC
  476.       N=True : Repeat 
  477.          Multi Wait : MZ=Mouse Zone
  478.          If 70-MZ<>N and N>True Then S=False : Gosub D_ITEM : N=True
  479.          If Mouse Zone>70-I and Mouse Zone<71 Then N=70-MZ : S=True : Gosub D_ITEM
  480.       Until Mouse Key=False
  481.       If S : I$=Right$(M$(N,1),1) : SH=Left$(M$(N,1),1)="^" : ALT=Left$(M$(N,1),1)="�" : End If : Inc N
  482.    Until N=False or S
  483.    DILOG_C[70] : Goto FIN4
  484.    D_ITEM: Ink 5 and S : WRITE[8,N*10+11,M$(N,0)]
  485.    If M$(N,1)="" Then Return 
  486.    If Instr(M$(N,1),"^") Then Paste Bob 135+XOFF,N*10+5+YOFF,10-S
  487.    If Instr(M$(N,1),"�") Then Paste Bob 127+XOFF,N*10+5+YOFF,8-S
  488.    WRITE[143,N*10+11,Right$(M$(N,1),1)] : Return 
  489.    FIN4:
  490. End Proc[N and S]
  491. Procedure CONFIRM[T$]
  492.    If A_ALT=False and F_ALT=False Then P=True : Goto FIN5
  493.    REQUEST["Save changes","before "+Lower$(T$)+"ing?","Yes","No","Cancel"] : P=Param=2
  494.    If Param=1 Then SVE[False] : P=Param
  495.    FIN5:
  496. End Proc[P]
  497. Procedure REQUEST[L1$,L2$,B1$,B2$,B3$]
  498.    S=Screen : Screen False : DILOG_O[141,0,140,44+(B3$<>"" and 12)]
  499.    Ink 0 : WRITE[70-(Text Length(L1$))/2,11,L1$] : WRITE[70-(Text Length(L2$))/2,21,L2$]
  500.    X=134 : If B2$<>"" Then Add X,-Max(Text Length(B2$),40)-11 : BUT_O[9,X+3,25,B2$]
  501.    If B1$<>"" Then Add X,-Max(Text Length(B1$),40)-10 : BUT_O[8,X+2,25,B1$]
  502.    If B3$<>"" Then BUT_O[10,(140-X-Max((Text Length(B3$)),40)-10)/2+X,39,B3$]
  503.    Paste Bob 6+XOFF,24+YOFF,2
  504.    Repeat : Repeat : MZ=Mouse Zone : MC=Mouse Click : Until MC and MZ>7 and MZ<11
  505.       If MZ=8 Then CLICK[8,B1$]
  506.       If MZ=9 Then CLICK[9,B2$]
  507.       If MZ=10 Then CLICK[10,B3$]
  508.    Until Param : DILOG_C[10] : Screen S
  509. End Proc[MZ-7]
  510. Procedure S_REQ[T$,M,C]
  511.    DILOG_O[52,8,194,40]
  512.    Ink False : CENT[97,10,T$] : Screen Copy 0,281,28,305,40 To 0,166+XOFF,12+YOFF : SZ[67,166,12,177,23] : SZ[66,178,12,189,23]
  513.    BUT_O[70,35,24,"Ok"] : BUT_O[69,84,24,"Cancel"] : Gosub SLD
  514.    Do : Repeat : Multi Wait : MZ=Mouse Zone : MC=Mouse Click : Until MC
  515.       If MZ=67 Then CLICK[67,""] : If Param and C>1 Then Dec C : Gosub SLD
  516.       If MZ=66 Then CLICK[66,""] : If Param and C<M Then Inc C : Gosub SLD
  517.       If MZ=68 : T=False : D=X Screen(X Mouse)-Z(68,0)/65536 : L=Max(125/M,6)
  518.          Repeat : Multi Wait : X=Min(Max(X Screen(X Mouse)-D-XOFF-3,0),125-L)
  519.             If T<>X : T=X : C=((X*(M-1)*2)/Max(125-L,1)+1)/2+1 : SZ[68,X+3,13,X+L+3,22] : Cls 2,3+XOFF,13+YOFF To 129+XOFF,23+YOFF : BUTTN[68,"",True] : Gosub SLD2 : End If 
  520.          Until Mouse Key=False
  521.       Gosub SLD : End If 
  522.       If MZ=69 Then CLICK[69,"Cancel"] : If Param Then C=False : Exit 
  523.       If MZ=70 Then CLICK[70,"Ok"] : Exit If Param
  524.    Loop 
  525.    DILOG_C[70] : Goto FIN7
  526.    SLD: SLD[68,2,12,129,C,M]
  527.    SLD2: Ink 4,,0 : Set Paint True : Bar 129+XOFF,12+YOFF To 165+XOFF,23+YOFF : Ink 0 : WRITE[130,22,Str$(C)] : Return 
  528.    FIN7:
  529. End Proc[C]
  530. Procedure DILOG_O[X,Y,X2,Y2]
  531.    X=X/2*2 : X2=X2/2*2+X : Add Y2,Y : BORD[4] : Cls 2,X,Y To X2,Y2 : Change Mouse 1 : F=Free
  532.    DIL$=Chr$(X/2)+Chr$(Y)+Chr$(X2/2)+Chr$(Y2)+DIL$ : XOFF=X : YOFF=Y : BORD[5]
  533. End Proc
  534. Procedure DILOG_C[Z]
  535.    Cls 2,XOFF,YOFF To Asc(Mid$(DIL$,3))*2,Asc(Mid$(DIL$,4)) : DIL$=Mid$(DIL$,5) : XOFF=Asc(Left$(DIL$,1))*2 : YOFF=Asc(Mid$(DIL$,2)) : BORD[5] : If Len(DIL$)=4 Then REFRESH
  536.    If Z Then For N=1 To Z : Reset Zone N : Next 
  537. End Proc
  538. Procedure BORD[C]
  539.    X2=Asc(Mid$(DIL$,3))*2 : Y2=Asc(Mid$(DIL$,4))
  540.    Ink 0 : Box XOFF,YOFF To X2-1,Y2-1 : Box XOFF+2,YOFF+2 To X2-3,Y2-3 : Ink C : Box XOFF+1,YOFF+1 To X2-2,Y2-2
  541. End Proc
  542. Procedure WRITE[X,Y,T$]
  543.    Gr Writing False : Text X+XOFF,Y+YOFF,(T$)
  544. End Proc
  545. Procedure CENT[X,Y,T$]
  546.    WRITE[X-(Text Length(T$))/2,Y,T$]
  547. End Proc
  548. Procedure SZ[Z,X,Y,X2,Y2]
  549.    Add X,XOFF : Add Y,YOFF : Add X2,XOFF : Add Y2,YOFF
  550.    Set Zone Z,X,Y To X2,Y2 : Z(Z,0)=X*65536+Y : Z(Z,1)=X2*65536+Y2
  551. End Proc
  552. Procedure CHECK[Z,S]
  553.    BUTTN[Z,"",True] : Paste Bob Z(Z,0)/65536+2,Z(Z,0) mod 65536+2,6-S
  554. End Proc
  555. Procedure CLICK[Z,T$]
  556.    S=False
  557.    Repeat 
  558.       Multi Wait 
  559.       If(Mouse Zone=Z)<>S Then BUTTN[Z,T$,S] : S= Not S
  560.    Until Mouse Key=False
  561.    BUTTN[Z,T$,True]
  562. End Proc[S]
  563. Procedure BUTTN[Z,T$,UP]
  564.    X=Z(Z,0)/65536 : Y=Z(Z,0) mod 65536 : X2=Z(Z,1)/65536 : Y2=Z(Z,1) mod 65536
  565.    Ink 5 and Not UP : Text(X+X2)/2-(Text Length(T$))/2,Y+9,T$ : UP=2 and UP
  566.    Ink 1+UP : Polyline X2-1,Y To X,Y To X,Y2-1 : Ink 3-UP : Polyline X+1,Y2 To X2,Y2 To X2,Y+1
  567. End Proc
  568. Procedure BUT_O[Z,X,Y,T$]
  569.    SZ[Z,X,Y,X+Max((Text Length(T$)),40)+8,Y+12] : BUTTN[Z,T$,True]
  570. End Proc
  571. Procedure SLD[Z,X,Y,X2,Q,M]
  572.    Ink False : Box X+XOFF,Y+YOFF To X2+XOFF,Y+11+YOFF : D=X2-X-2
  573.    L=Max(D/M,6) : N=((D-L)*(Q-1))/Max(1,M-1)+1
  574.    SZ[Z,X+N,Y+1,X+N+L,Y+10] : Cls 2,X+1+XOFF,Y+1+YOFF To X2+XOFF,Y+11+YOFF : BUTTN[Z,"",True]
  575. End Proc